home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Controls / Visual Basic Controls.iso / vbcontrol / messag / dplibobj.ba_ / dplibobj.ba
Encoding:
Text File  |  1995-01-14  |  15.0 KB  |  405 lines
  1. 'DPLIBOBJ.BAS (short version)
  2. '1/15/95
  3. 'Digital PowerTOOLS Library for Objects
  4. 'Copyright (c) 1995 by Digital PowerTOOLS
  5.  
  6. 'these functions and subroutines are intended ONLY for use
  7. 'in your application; you are not authorized to distribute
  8. 'this source code
  9.  
  10. Type ObjRect
  11.     Left As Integer
  12.     Top As Integer
  13.     right As Integer
  14.     bottom As Integer
  15. End Type
  16.  
  17. Declare Sub GetWindowRect Lib "User" (ByVal hWnd%, lpRect As ObjRect)
  18. Declare Function GetDC% Lib "User" (ByVal hWnd%)
  19. Declare Function ReleaseDC% Lib "User" (ByVal hWnd%, ByVal hDC%)
  20. Declare Sub Rectangle Lib "GDI" (ByVal hDC%, ByVal X1%, ByVal Y1%, ByVal X2%, ByVal Y2%)
  21. Declare Function CreateSolidBrush% Lib "GDI" (ByVal crColor&)
  22. Declare Function SelectObject% Lib "GDI" (ByVal hDC%, ByVal hObject%)
  23. Declare Sub DeleteObject Lib "GDI" (ByVal hObject%)
  24.  
  25. Declare Function FillRect Lib "User" (ByVal hDC As Integer, lpRect As ObjRect, ByVal hBrush As Integer) As Integer
  26. Declare Function AltDeleteObject Lib "GDI" Alias "DeleteObject" (ByVal hObject As Integer) As Integer
  27.  
  28. Sub DoControl3D (Obj As Control, Style, thick)
  29. 'draws 3D shadows effects around a control
  30. 'Style is either "sunken" or "raised"
  31.  
  32. 'use this function in the Paint event of the form
  33.  
  34.     If thick <= 0 Then thick = 1
  35.     If thick > 8 Then thick = 8
  36.     OldMode = Obj.Parent.ScaleMode
  37.     OldWidth = Obj.Parent.DrawWidth
  38.     Obj.Parent.ScaleMode = 3
  39.     Obj.Parent.DrawWidth = 1
  40.     ObjHeight = Obj.Height
  41.     ObjWidth = Obj.Width
  42.     ObjLeft = Obj.Left
  43.     ObjTop = Obj.Top
  44.     
  45.     Select Case LCase$(Style)
  46.         Case "sunken":
  47.             TLshade = QBColor(8)
  48.             BRshade = QBColor(15)
  49.         Case "raised":
  50.             TLshade = QBColor(15)
  51.             BRshade = QBColor(8)
  52.         End Select
  53.         For i = 1 To thick
  54.             CurLeft = ObjLeft - i
  55.             CurTop = ObjTop - i
  56.             CurWide = ObjWidth + (i * 2) - 1
  57.             CurHigh = ObjHeight + (i * 2) - 1
  58.             Obj.Parent.Line (CurLeft, CurTop)-Step(CurWide, 0), TLshade
  59.             Obj.Parent.Line -Step(0, CurHigh), BRshade
  60.             Obj.Parent.Line -Step(-CurWide, 0), BRshade
  61.             Obj.Parent.Line -Step(0, -CurHigh), TLshade
  62.             Next i
  63.         If thick > 2 Then
  64.             CurLeft = ObjLeft - thick - 1
  65.             CurTop = ObjTop - thick - 1
  66.             CurWide = ObjWidth + ((thick + 1) * 2) - 1
  67.             CurHigh = ObjHeight + ((thick + 1) * 2) - 1
  68.             Obj.Parent.Line (CurLeft, CurTop)-Step(CurWide, 0), QBColor(0)
  69.             Obj.Parent.Line -Step(0, CurHigh), QBColor(0)
  70.             Obj.Parent.Line -Step(-CurWide, 0), QBColor(0)
  71.             Obj.Parent.Line -Step(0, -CurHigh), QBColor(0)
  72.             End If
  73.     Obj.Parent.ScaleMode = OldMode
  74.     Obj.Parent.DrawWidth = OldWidth
  75. End Sub
  76.  
  77. Sub DoEtchedFrame (Obj As PictureBox, TextMsg, Just, ColorVal&, TextStyle, ObjStyle)
  78. 'makes a PictureBox look like a stylized Frame (GroupBox)
  79. 'PictureBoxes can contain option buttons
  80.  
  81. 'Just is "left", "right", or "center"
  82. 'TextStyle is either "sunken" or "raised"
  83. 'ObjStyle is either "sunken" or "raised"
  84.  
  85. 'use this function in the Paint event of the form
  86.     
  87.     Obj.BorderStyle = 0
  88.     Obj.AutoRedraw = True
  89.     OldScaleMode = Obj.ScaleMode
  90.     Obj.ScaleMode = 1
  91.     OldDrawMode = Obj.DrawWidth
  92.     Obj.DrawWidth = 1
  93.     
  94.     TxLen% = Obj.TextWidth(TextMsg)
  95.     Obj.ForeColor = ColorVal
  96.     Cur1Left% = Obj.ScaleLeft + 15
  97.     Cur1Top% = Obj.ScaleTop + (Obj.TextHeight("A") / 2)
  98.     Cur1Wide% = Obj.ScaleWidth - 30
  99.     Cur1High% = (Obj.ScaleHeight - 30)
  100.     Cur2Left% = Obj.ScaleLeft
  101.     Cur2Top% = Obj.ScaleTop + ((Obj.TextHeight("A") / 2) - 10)
  102.     Cur2Wide% = Obj.ScaleWidth - 15
  103.     Cur2High% = (Obj.ScaleHeight - 10)
  104.     
  105.     Select Case LCase$(Just)
  106.         Case "left"
  107.             Left1Start% = Cur1Left%
  108.             Left1End% = 120
  109.             Right1Start% = Left1End% + TxLen% + 240
  110.             Right1End% = Cur1Wide%
  111.             Left2Start% = Cur2Left%
  112.             Left2End% = 110
  113.             Right2Start% = Left2End% + TxLen% + 240
  114.             Right2End% = Cur2Wide%
  115.             Xpos% = 240
  116.             Ypos% = 0
  117.         Case "right"
  118.             Left1Start% = Cur1Left%
  119.             Left1End% = (Cur1Wide% - TxLen%) - 350
  120.             Right1Start% = Cur1Wide% - 120
  121.             Right1End% = Cur1Wide%
  122.             Left2Start% = Cur2Left%
  123.             Left2End% = (Cur2Wide% - TxLen%) - 350
  124.             Right2Start% = Cur2Wide% - 130
  125.             Right2End% = Cur2Wide%
  126.             Xpos% = Left1End% + 120
  127.             Ypos% = 0
  128.         Case "center"
  129.             Left1Start% = Cur1Left%
  130.             Left1End% = (Cur1Wide% - (TxLen% + 240)) / 2
  131.             Right1Start% = Cur1Wide% - Left1End%
  132.             Right1End% = Cur1Wide%
  133.             Left2Start% = Cur2Left%
  134.             Left2End% = (Cur2Wide% - (TxLen% + 240)) / 2
  135.             Right2Start% = Cur2Wide% - Left2End%
  136.             Right2End% = Cur2Wide%
  137.             Xpos% = Left1End% + 120
  138.             Ypos% = 0
  139.         End Select
  140.     
  141.     If LCase$(TextStyle) = "sunken" Then
  142.            Obj.CurrentX = Xpos% + 15
  143.            Obj.CurrentY = Ypos% + 15
  144.            Obj.ForeColor = QBColor(8)
  145.            Obj.Print TextMsg
  146.         End If
  147.     If LCase$(TextStyle) = "raised" Then
  148.            Obj.CurrentX = Xpos% - 15
  149.            Obj.CurrentY = Ypos% - 15
  150.            Obj.ForeColor = QBColor(15)
  151.            Obj.Print TextMsg
  152.            Obj.CurrentX = Xpos% + 15
  153.            Obj.CurrentY = Ypos% + 15
  154.            Obj.ForeColor = QBColor(8)
  155.            Obj.Print TextMsg
  156.         End If
  157.     Obj.CurrentX = Xpos%
  158.     Obj.CurrentY = Ypos%
  159.     Obj.ForeColor = ColorVal
  160.     Obj.Print TextMsg
  161.     
  162.     Select Case LCase$(ObjStyle)
  163.         Case "sunken"
  164.             TLshade = QBColor(15)
  165.             BRshade = QBColor(8)
  166.         Case "raised"
  167.             TLshade = QBColor(8)
  168.             BRshade = QBColor(15)
  169.         End Select
  170.             
  171.     Obj.Line (Left1Start%, Cur1Top%)-(Left1End%, Cur1Top%), TLshade
  172.     Obj.Line (Right1Start%, Cur1Top%)-(Right1End%, Cur1Top%), TLshade
  173.     Obj.Line (Right1End%, Cur1Top%)-(Right1End%, Cur1High%), BRshade
  174.     Obj.Line (Right1End%, Cur1High%)-(Left1Start%, Cur1High%), BRshade
  175.     Obj.Line (Left1Start%, Cur1High%)-(Left1Start%, Cur1Top%), TLshade
  176.     Obj.Line (Left2Start%, Cur2Top%)-(Left2End%, Cur2Top%), BRshade
  177.     Obj.Line (Right2Start%, Cur2Top%)-(Right2End%, Cur2Top%), BRshade
  178.     Obj.Line (Right2End%, Cur2Top%)-(Right2End%, Cur2High%), TLshade
  179.     Obj.Line (Right2End%, Cur2High%)-(Left2Start%, Cur2High%), TLshade
  180.     Obj.Line (Left2Start%, Cur2High%)-(Left2Start%, Cur2Top%), BRshade
  181.     
  182.     Obj.ScaleMode = OldScaleMode
  183.     Obj.DrawWidth = OldDrawMode
  184.     Obj.AutoRedraw = False
  185. End Sub
  186.  
  187. Sub DoForm3D (TheForm As Form, Style, thick, Distance)
  188. 'draws 3D shadow effects on a form
  189. 'can be called with different values for a variety of effects
  190. 'Style is either "sunken" or "raised"
  191.  
  192. 'use this function in the Paint event of the form
  193.  
  194.     If thick <= 0 Then thick = 1
  195.     If thick > 8 Then thick = 8
  196.     If Distance < 0 Then Distance = 0
  197.     If Distance > 8 Then Distance = 8
  198.     OldMode = TheForm.ScaleMode
  199.     OldWidth = TheForm.DrawWidth
  200.     TheForm.ScaleMode = 3
  201.     TheForm.DrawWidth = 1
  202.     FormHeight = TheForm.ScaleHeight
  203.     FormWidth = TheForm.ScaleWidth
  204.     FormLeft = TheForm.ScaleLeft
  205.     FormTop = TheForm.ScaleTop
  206.     
  207.     Select Case LCase$(Style)
  208.         Case "sunken":
  209.             TLshade = QBColor(8)
  210.             BRshade = QBColor(15)
  211.         Case "raised":
  212.             TLshade = QBColor(15)
  213.             BRshade = QBColor(8)
  214.         End Select
  215.     Select Case TheForm.BorderStyle
  216.         Case 0:
  217.             OLshade = QBColor(0)
  218.             TheForm.Line (0, 0)-(FormWidth, 0), OLshade
  219.             TheForm.Line (0, 0)-(0, FormHeight), OLshade
  220.             TheForm.Line (FormWidth - 1, 0)-(FormWidth - 1, FormHeight + 1), OLshade
  221.             TheForm.Line (0, FormHeight - 1)-(FormWidth, FormHeight - 1), OLshade
  222.             For i = 1 To thick
  223.                 CurLeft = FormLeft + i + Distance
  224.                 CurTop = FormTop + i + Distance
  225.                 CurWide = FormWidth - (i + Distance) * 2 - 1
  226.                 CurHigh = FormHeight - (i + Distance) * 2 - 1
  227.                 TheForm.Line (CurLeft, CurTop)-Step(CurWide, 0), TLshade
  228.                 TheForm.Line -Step(0, CurHigh), BRshade
  229.                 TheForm.Line -Step(-CurWide, 0), BRshade
  230.                 TheForm.Line -Step(0, -CurHigh), TLshade
  231.                 Next i
  232.         Case 1 To 3:
  233.             If Thickness = 1 Then
  234.                 TheForm.Line (thick, thick)-(FormWidth - thick, thick), TLshade
  235.                 TheForm.Line (thick, thick)-(thick, FormHeight - thick), TLshade
  236.                 TheForm.Line (FormWidth - thick, thick)-(FormWidth - thick, FormHeight - thick + 1), BRshade
  237.                 TheForm.Line (thick, FormHeight - thick)-(FormWidth - thick, FormHeight - thick), BRshade
  238.                 Else
  239.             For i = 1 To thick
  240.                 CurLeft = FormLeft + i - 1 + Distance
  241.                 CurTop = FormTop + i - 1 + Distance
  242.                 CurWide = FormWidth - (i + Distance) * 2 + 1
  243.                 CurHigh = FormHeight - (i + Distance) * 2 + 1
  244.                 TheForm.Line (CurLeft, CurTop)-Step(CurWide, 0), TLshade
  245.                 TheForm.Line -Step(0, CurHigh), BRshade
  246.                 TheForm.Line -Step(-CurWide, 0), BRshade
  247.                 TheForm.Line -Step(0, -CurHigh), TLshade
  248.                 Next i
  249.                 End If
  250.         End Select
  251.     TheForm.ScaleMode = OldMode
  252.     TheForm.DrawWidth = OldWidth
  253. End Sub
  254.  
  255. Sub DoPicture3D (ThePB As PictureBox, Style, thick, Distance)
  256. 'draws 3D shadow effects on a PictureBox
  257. 'can be called with different values for a variety of effects
  258. 'Style is either "sunken" or "raised"
  259. 'great for VB coded statusbars, etc.
  260.  
  261. 'use this function in the Paint event of the PictureBox
  262.     
  263.     If thick <= 0 Then thick = 1
  264.     If thick > 8 Then thick = 8
  265.     If Distance < 0 Then Distance = 0
  266.     If Distance > 8 Then Distance = 8
  267.     OldMode = ThePB.ScaleMode
  268.     OldWidth = ThePB.DrawWidth
  269.     ThePB.ScaleMode = 3
  270.     ThePB.DrawWidth = 1
  271.     FormHeight = ThePB.ScaleHeight
  272.     FormWidth = ThePB.ScaleWidth
  273.     FormLeft = ThePB.ScaleLeft
  274.     FormTop = ThePB.ScaleTop
  275.     
  276.     Select Case LCase$(Style)
  277.         Case "sunken":
  278.             TLshade = QBColor(8)
  279.             BRshade = QBColor(15)
  280.         Case "raised":
  281.             TLshade = QBColor(15)
  282.             BRshade = QBColor(8)
  283.         End Select
  284.     Select Case ThePB.BorderStyle
  285.         Case 0:
  286.             OLshade = QBColor(0)
  287.             ThePB.Line (0, 0)-(FormWidth, 0), OLshade
  288.             ThePB.Line (0, 0)-(0, FormHeight), OLshade
  289.             ThePB.Line (FormWidth - 1, 0)-(FormWidth - 1, FormHeight + 1), OLshade
  290.             ThePB.Line (0, FormHeight - 1)-(FormWidth, FormHeight - 1), OLshade
  291.             For i = 1 To thick
  292.                 CurLeft = FormLeft + i + Distance
  293.                 CurTop = FormTop + i + Distance
  294.                 CurWide = FormWidth - (i + Distance) * 2 - 1
  295.                 CurHigh = FormHeight - (i + Distance) * 2 - 1
  296.                 ThePB.Line (CurLeft, CurTop)-Step(CurWide, 0), TLshade
  297.                 ThePB.Line -Step(0, CurHigh), BRshade
  298.                 ThePB.Line -Step(-CurWide, 0), BRshade
  299.                 ThePB.Line -Step(0, -CurHigh), TLshade
  300.                 Next i
  301.         Case 1 To 3:
  302.             If Thickness = 1 Then
  303.                 ThePB.Line (thick, thick)-(FormWidth - thick, thick), TLshade
  304.                 ThePB.Line (thick, thick)-(thick, FormHeight - thick), TLshade
  305.                 ThePB.Line (FormWidth - thick, thick)-(FormWidth - thick, FormHeight - thick + 1), BRshade
  306.                 ThePB.Line (thick, FormHeight - thick)-(FormWidth - thick, FormHeight - thick), BRshade
  307.                 Else
  308.             For i = 1 To thick
  309.                 CurLeft = FormLeft + i - 1 + Distance
  310.                 CurTop = FormTop + i - 1 + Distance
  311.                 CurWide = FormWidth - (i + Distance) * 2 + 1
  312.                 CurHigh = FormHeight - (i + Distance) * 2 + 1
  313.                 ThePB.Line (CurLeft, CurTop)-Step(CurWide, 0), TLshade
  314.                 ThePB.Line -Step(0, CurHigh), BRshade
  315.                 ThePB.Line -Step(-CurWide, 0), BRshade
  316.                 ThePB.Line -Step(0, -CurHigh), TLshade
  317.                 Next i
  318.                 End If
  319.         End Select
  320.     ThePB.ScaleMode = OldMode
  321.     ThePB.DrawWidth = OldWidth
  322. End Sub
  323.  
  324. Sub FormBLscreen (TheForm As Form)
  325.     If TheForm.WindowState = 0 Then
  326.         BotPos = Screen.Height - TheForm.Height
  327.         TheForm.Move (0), (BotPos)
  328.         End If
  329. End Sub
  330.  
  331. Sub FormBRscreen (TheForm As Form)
  332.     If TheForm.WindowState = 0 Then
  333.         BotPos = Screen.Height - TheForm.Height
  334.         RightPos = Screen.Width - TheForm.Width
  335.         TheForm.Move (RightPos), (BotPos)
  336.         End If
  337. End Sub
  338.  
  339. Sub FormCenterForm (TheForm As Form, MainForm As Form)
  340. 'centers one (nonMDIchild) form within another form
  341.  
  342.     If TheForm.WindowState = 0 Then
  343.         TheForm.Move MainForm.Left + (MainForm.Width - TheForm.Width) / 2, MainForm.Top + (MainForm.Height - TheForm.Height) / 2
  344.         End If
  345. End Sub
  346.  
  347. Sub FormCenterScreen (TheForm As Form)
  348. 'centers a form on the screen
  349. 'great for primary form and modal forms
  350.     
  351.     If TheForm.WindowState = 0 Then
  352.         TheForm.Move (Screen.Width - TheForm.Width) / 2, (Screen.Height - TheForm.Height) / 2
  353.         End If
  354. End Sub
  355.  
  356. Sub FormTLscreen (TheForm As Form)
  357.     If TheForm.WindowState = 0 Then TheForm.Move (0), (0)
  358. End Sub
  359.  
  360. Sub FormTRscreen (TheForm As Form)
  361.     If TheForm.WindowState = 0 Then
  362.         RightPos = Screen.Width - TheForm.Width
  363.         TheForm.Move (RightPos), (0)
  364.         End If
  365. End Sub
  366.  
  367. Sub ShowForm (TheForm As Form, Style, FillColor&, SpeedFactor)
  368. 'displays a form in stylized fashion
  369. 'set the form's color (in design mode) to the same value as FillColor&
  370.  
  371. 'Style="CenterOut", "CenterDown", or "LeftDown"
  372. 'the higher the speed facter, the slower the dispay
  373. '   use 1 - 10 for best results
  374.     
  375.     Dim FormRect As ObjRect
  376.     GetWindowRect TheForm.hWnd, FormRect
  377.     FullWidth = FormRect.right - FormRect.Left
  378.     FullHeight = FormRect.bottom - FormRect.Top
  379.     ScreenHDC% = GetDC(0)
  380.     hBrush% = CreateSolidBrush(FillColor)
  381.     OldBrushHndl% = SelectObject(ScreenHDC%, hBrush%)
  382.     
  383.     speed = SpeedFactor * 25
  384.     For index = 1 To speed
  385.         xx% = FullWidth * (index / speed)
  386.         yy% = FullHeight * (index / speed)
  387.         Select Case LCase$(Style)
  388.             Case "center outward"
  389.                 x% = FormRect.Left + (FullWidth - xx%) / 2
  390.                 y% = FormRect.Top + (FullHeight - yy%) / 2
  391.             Case "center downward"
  392.                 x% = FormRect.Left + (FullWidth - xx%) / 2
  393.                 y% = FormRect.Top
  394.             Case "left downward"
  395.                 x% = FormRect.Left
  396.                 y% = FormRect.Top
  397.                 End Select
  398.         Rectangle ScreenHDC%, x%, y%, x% + xx%, y% + yy%
  399.     Next index
  400.     ret% = ReleaseDC(0, ScreenHDC%)
  401.     DeleteObject (hBrush%)
  402.     TheForm.Visible = True
  403. End Sub
  404.  
  405.